PROGRAM BDY2BIN

! Converts ASCII boundary files to a packed concentration format file which
! can then be plotted using any of the HYSPLIT concentration plot programs.
! Note that the first data point on the first record is centered at the 
! northwest corner and the data goes eastward and then southward by record.
! Last Revised: 01 April 2015

  IMPLICIT NONE

  CHARACTER(11) :: FNAME
  INTEGER(4)    :: NLAT=181
  INTEGER(4)    :: NLON=360
  REAL(4)       :: DLAT=1.0
  REAL(4)       :: DLON=1.0
  REAL(4)       :: CLAT=-90.0 
  REAL(4)       :: CLON=-180.0
  INTEGER(4)    :: j,numb

  CHARACTER(7)  :: LABEL(3)
  LOGICAL       :: QFILE

  REAL(4),    ALLOCATABLE :: RVAL(:,:)  
  INTEGER(4), ALLOCATABLE :: DVAL(:) 

  DATA LABEL/'LANDUSE','ROUGLEN','TERRAIN'/

  INTERFACE
    SUBROUTINE CONWRITE (FNAME,VARB,NLAT,NLON,DLAT,DLON,CLAT,CLON,RVAL)
    IMPLICIT NONE
    CHARACTER(11), INTENT(IN) :: FNAME
    CHARACTER(4),  INTENT(IN) :: VARB
    INTEGER(4),    INTENT(IN) :: NLAT,NLON
    REAL(4),       INTENT(IN) :: DLAT,DLON,CLAT,CLON
    REAL(4),       INTENT(IN) :: RVAL(:,:)
    END SUBROUTINE conwrite
  END INTERFACE

  INQUIRE(FILE='ASCDATA.ASC',EXIST=QFILE)
  IF(QFILE)THEN
     OPEN(10,FILE='ASCDATA.ASC',ACTION='READ')
     WRITE(*,*)'NOTICE: reading ASCDATA.ASC'
     READ(10,*)CLAT,CLON
     READ(10,*)DLAT,DLON
     READ(10,*)NLAT,NLON
     CLOSE(10)
  END IF

  IF(NLON.GT.1440)THEN
     WRITE(*,*)'Longitude dimension exceeded: ',NLON
     WRITE(*,*)'Recompile!'
     STOP
  END IF
  ALLOCATE (RVAL(NLON,NLAT), DVAL(NLON))
  WRITE(*,*)'Grid corner: ',CLAT,CLON
  WRITE(*,*)'Grid delta:  ',DLAT,DLON
  WRITE(*,*)'Number pnts: ',NLAT,NLON

  WRITE(*,*)'1 - landuse.asc'
  WRITE(*,*)'2 - rouglen.asc'
  WRITE(*,*)'3 - terrain.asc'
  WRITE(*,*)'Select Input File Number: '      
  READ(*,*)  NUMB 

  OPEN(10,FILE=LABEL(NUMB)//'.ASC')

  DO J=NLAT,1,-1
     READ(10,'(1440I4)') DVAL
     RVAL(:,J)=DVAL
  END DO

  CALL conwrite(LABEL(NUMB)//'.BIN',LABEL(NUMB)(1:4),nlat,nlon,dlat,dlon,clat,clon,rval)

 END PROGRAM BDY2BIN

!----------------------------------------------------------

SUBROUTINE CONWRITE (FNAME,VARB,NLAT,NLON,DLAT,DLON,CLAT,CLON,RVAL)

  IMPLICIT NONE

  CHARACTER(11), INTENT(IN) :: FNAME
  CHARACTER(4),  INTENT(IN) :: VARB
  INTEGER(4),    INTENT(IN) :: NLAT,NLON
  REAL(4),       INTENT(IN) :: DLAT,DLON,CLAT,CLON
  REAL(4),       INTENT(IN) :: RVAL(:,:)
  INTEGER(4)                :: i,j

  OPEN(50,FILE=FNAME,FORM='UNFORMATTED',ACCESS='SEQUENTIAL')
  WRITE(50)VARB,0,0,0,0,0,1,0             ! MODEL,IYR,IMO,IDA,IHR,ICH,NLOC,CPACK
  WRITE(50)0,0,0,0,0.0,0.0,0.0            ! IBYR,IBMO,IBDA,IBHR,OLAT,OLON,OLVL
  WRITE(50)NLAT,NLON,DLAT,DLON,CLAT,CLON
  WRITE(50)1,0                            ! NLVL,(HEIGHT(KK),KK=1,NLVL)
  WRITE(50)1,VARB                         ! NTYP,(IDENT(KK),KK=1,NTYP)
  WRITE(50)0,0,0,0,0,0                    ! IYR,IMO,IDA,IHR,IMN,IFH
  WRITE(50)0,0,0,0,0,0
  WRITE(50) VARB,0,((RVAL(I,J),I=1,NLON),J=1,NLAT)
  CLOSE(50)

END SUBROUTINE conwrite